home *** CD-ROM | disk | FTP | other *** search
/ Aminet 5 / Aminet 5 - March 1995.iso / Aminet / util / rexx / ARexxG2_0A.lha / ARexxGuide / ARexxGuide.rexx < prev    next >
OS/2 REXX Batch file  |  1994-04-10  |  8KB  |  231 lines
  1. /* $VER: 2.0a ARexxGuide.rexx (10 Apr 1994) by Robin Evans
  2.  
  3.         Launch ARexxGuide. Will optionally opens a public screen with
  4.         rexxarplib, and load in the requester port if that version is used.
  5.  
  6.         It also closes down after AmigaGuide is closed and any of the ports
  7.         that might have been opened by ARexxGuide. It removes amigaguide.library
  8.         from memory since some versions that library can interfere with other
  9.         ARexx function libraries.
  10.  
  11.         Initial setup is done with the file ARx_Setup.rexx. That file
  12.         is required to get started and required if the Env:ARexxGuide vars.
  13.         are deleted. Otherwise it isn't needed.
  14.  
  15. */
  16. /* call trace 'b'*/
  17. signal ON ERROR
  18. signal ON FAILURE
  19. signal on syntax
  20.  
  21. if ~show('P', 'ARX_GUIDE') then do
  22.  
  23.         /* It will mess up CheckLib if it's on the list */
  24.     call remlib('amigaguide.library')
  25.     AddBackLibs = RemUnknownLib()
  26.     if ~checklib('rexxsupport.library',0,-30,0) then signal NoSpt
  27.         /* add it back at a higher priority */
  28.     call remlib('rexxreqtools.library')
  29.     ReqT = CheckLib('rexxreqtools.library',32)
  30.    Rarp = CheckLib('rexxarplib.library')
  31.  
  32.         /* Run setup if it hasn't been done yet */
  33.     if find(getenv('arexxguide/setup'), 'LAUNCH') = 0 then
  34.         call 'ARx_Setup.rexx'('LAUNCH')
  35.  
  36.         /* Get command used to show AmigaGuide                     */
  37.     AGCmd = getenv('ARexxGuide/AGCmd')
  38.     if AGCmd = '' then  signal NOCMD
  39.  
  40.     if abbrev(AGCmd, 'Multi') then
  41.         PrtOpt = ''
  42.     else
  43.         PrtOpt = 'portname ARX_GUIDE'
  44.  
  45.         /* If this is the requester version, then load the requester port **
  46.         ** now so it will be available when first used.                   */
  47.     if ReqT & getenv('ARexxguide/RqVer') = 1 then
  48.             /* Give it a fake lookup word, just so the port will open      */
  49.         address AREXX '"ARx_GlossaryPort.rexx ''foo'' ''ARX_GUIDE''"'
  50.  
  51.             /* Open a pubscreen if requested */
  52.     ARxScr = ''             /* pub screen option not used by default */
  53.     PScr = getenv('arexxguide/PubScr')
  54.     if PScr = '' then PScr = 'WORKBENCH'
  55.         /* This uses rexxarplib to open a public screen. Other utilities **
  56.         ** could be substituted. Even under 2.0+, rexxarplib works best  **
  57.         ** if screenshare.library is available. I haven't yet been able  **
  58.         ** to get apig.library to open a public screen. If anyone knows  **
  59.         ** how to do that, tell me, and I'll add apig.library as the     **
  60.         ** first choice.                                                 */
  61.     if RArp then do
  62.         if ~((PScr = "") | (PScr = 'WORKBENCH')) then do
  63.             ArxScr = 'pubscreen' PScr
  64.             call setclip('ARxScreen', PScr)
  65.             if ScreenToFront(word(ARxScr,2)) = 0 then
  66.                 if ~OpenScreen((ScreenRows()-400) ,, 'HIRES|LACE', 'ARexxGuide', PScr,,640 ,400 ,(ScreenCols()-640)%2 ) then do
  67.                     ARxScr = ''
  68.                     call setclip('ARxScreen', PScr)
  69.                 end
  70.         end
  71.     end
  72.  
  73.     if AddBackLibs > '' then call ReturnLibs(AddBackLibs)
  74.  
  75.             /* This loads AmigaGuide (or Multiview) and then waits   */
  76.     address command AGCmd 'ARexxGuide.guide' PrtOpt ARxScr
  77.  
  78.             /* AG was closed so shut down everything we've set up    */
  79.     if PScr ~= 'WORKBENCH' then do
  80.         call CloseScreen(PScr)
  81.         call setclip('ARxScreen')
  82.     end
  83.         /* Turn off the requester port when AG is closed.            */
  84.     if show('P', 'ARX_REQPORT') then
  85.         address 'ARX_REQPORT' 'QUIT'
  86.  
  87.         /* Don't need amigaguide.library for this, so remove it from **
  88.         ** ARexx list (but probably not from mem.)                   */
  89.     if show('l', 'amigaguide.library') then do
  90.         call expungexref()
  91.         call remlib('amigaguide.library')
  92.     end
  93. end
  94. else do
  95.     /* This brings the window, or screen to the front if the guide  **
  96.     ** was already loaded.                                          */
  97.     address ARX_GUIDE
  98.     if getclip('ARxScreen') > '' then
  99.         call ScreenToFront(getclip('ARxScreen'))
  100.     'windowtofront'
  101.     'ActivateWindow'
  102. end
  103.  
  104. exit 0
  105.  
  106. NOCMD:
  107. ERROR:
  108. FAILURE:
  109.     call PutErrMsg(SIGL,'Couldn''t run AmigaGuide viewer. Check env:ARexxGuide/AGCmd\or run the setup program again by typing\   rx ARx_Setup\from a shell.')
  110.     if show('L', 'amigaguide.library') then do
  111.         call expungexref()
  112.         call remlib('amigaguide.library')
  113.     end
  114.     exit 0
  115.  
  116.  
  117.     /* This uses rexxarplib's GETENV() if it's here */
  118. GetEnv: procedure    expose RArp
  119.  
  120.     EnvVar = ''
  121.     if RArp = 1 then
  122.         EnvVar = 'GetEnv'(arg(1))
  123.     else if open(6Env, 'env:'arg(1), R) then do
  124.         EnvVar = readln(6Env)
  125.         call close 6Env
  126.     end
  127.     return EnvVar
  128.  
  129.  
  130. CountChar:
  131.    return length(arg(2)) - length(compress(arg(2), arg(1)))
  132.  
  133. RemUnknownLib: procedure
  134.     AddBackLibs = ''
  135.     /* remove unknown library names from the list to avoid problems    **
  136.     ** I'm not familiar with all the libs included here, so I won't    **
  137.     ** guarantee that they set a proper return code, but they are at   **
  138.     ** least documented in the ARexx Applications list.                */
  139.     KnownLib = 'rexxsupport.library rexxarplib.library rexxreqtools.library apig.library rexxextend.library RexxDosSupport.library rxgen.library rx_intui.library rexxmathlib.library rexxserdev.library GDArexxSupport.library rexxflow.library rexxarray.library xferq.library QuickSortPort REXX'
  140.         /* A few libs that we know don't belong on the list */
  141.     BadLib = 'rexxsyslib.library reqtools.library arp.library rexxapp.library'
  142.     CurLibs = show('l')
  143.     do i = 1 to words(CurLibs)
  144.         TLib = word(CurLibs,i)
  145.         if find(KnownLib, TLib) = 0 then do
  146.             call remlib(TLib)
  147.             if find(BadLib,TLib) = 0 then
  148.                 AddBackLibs = AddBackLibs TLib
  149.         end
  150.     end
  151.     return AddBackLibs
  152.  
  153. ReturnLibs:
  154.     do i = 1 to words(AddBackLibs)
  155.         if pos('.library', word(AddBackLibs,i)) > 0 then
  156.             call addlib(word(AddBackLibs, i), 0, -30, 0)
  157.         else
  158.             call addlib(word(AddBackLibs, i),-i-32)
  159.     end
  160.     AddBackLibs = ''    /* Changes the variable in calling environment */
  161.     return 0
  162.  
  163.  
  164. CheckLib: procedure
  165.     call trace(b)
  166.     CheckLib = 1
  167.     parse arg LibName, Priority, Offset, Version
  168.  
  169.     if LibName = '' then return 0    /* Must include a library name */
  170.     signal on syntax
  171.  
  172.  
  173.     if ~show('L', LibName) then do  /* Is the library already on the list? */
  174.           /* Set defaults for ADDLIB() */
  175.        if Priority = '' then Priority = 0
  176.        if Offset = '' then Offset = -30
  177.        if Version = '' then Version = 0
  178.           /* The return from the function doesn't matter, so use CALL¤¤    */
  179.        call addlib(LibName, Priority, Offset, Version)
  180.     end
  181.  
  182.        /* This call to a non-existent (I hope) function will force all     **
  183.        ** libraries to be loaded. It will generate a syntax error (#15)    **
  184.        ** but that will be trapped by the SIGNAL¤¤ instruction             */
  185.     call FooBarian()
  186.  
  187.        /* Unlikely we'd make it this far, but maybe someone will use       **
  188.        ** 'FooBarian' as a function name.                                  */
  189.     return 1
  190.  
  191. syntax:
  192.     signal off syntax
  193.     if CheckLib = 1 then do        /* Use default Checklib() didn't call it */
  194.           /* This subroutine will be called on any syntax error. The call  **
  195.           ** to FooBarian() above is almost guaranteed to generate an      **
  196.           ** error. We're interested in the type of error. #14 means that  **
  197.           ** the library we tried to load isn't available. #15 is OK. It   **
  198.           ** means "Function not found" and we expect that.                */
  199.        if rc = 14 then do
  200.           call remlib(LibName)
  201.           return 0
  202.        end
  203.        else
  204.           return 1    /* Function not found, but library was loaded        */
  205.     end
  206.     else do
  207.         call PutErrMsg(SIGL,'+++ Error' rc 'in line' SIGL':' errortext(rc))
  208.         exit 0
  209.     end
  210.  
  211. NoSpt:
  212.     call PutErrMsg(SIGL, 'rexxsupport.library could not be loaded.\Make sure the library is in your libs:\directory.')
  213.     exit 0
  214.  
  215. PutErrMsg:
  216.    call trace b
  217.    ErrMsg ='Sorry an enexpected error has occurred in line' arg(1)'.\\'arg(2)
  218.    signal off syntax
  219.    signal off halt
  220.    signal off break_c
  221.    WinHi = 59 + CountChar('\', ErrMsg) * 11
  222.    if open(6ErrWin, 'raw:0/0/640/'WinHi'/ARexxGuide.rexx error/SCREEN *') then do
  223.       call writeln(6ErrWin, translate(ErrMsg,'0a'x, '\'))
  224.       call writech(6ErrWin, '0a'x'        -- Press any key -- ')
  225.       call readch(6ErrWin)
  226.    end
  227.     call close 6ErrWin
  228.       if symbol('ADDBACKLIBS') = 'VAR' & AddBackLibs > '' then
  229.         call ReturnLibs(AddBackLibs)
  230.     return 0
  231.